home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SWAG / SWAGA_C / COMM.SWG / 0088_YModem Code.pas < prev   
Pascal/Delphi Source File  |  1995-05-26  |  5KB  |  149 lines
  1. {
  2. > HI, I over heard a message about pascal zmodem/xmodem/ymodem etc.
  3.  
  4.  Actually it's really really big, so i'll post a bit for one of the
  5.  ymodem's, plus i think i have to post a unit..
  6. }
  7.  
  8. FUNCTION  SENDYMODEM( filename : string; var f : file ) : boolean;
  9. CONST NULL = $0;
  10. VAR block : array[0..1023] of byte; (* byte *)
  11.      temp : string[5];
  12.      j,i  : integer;
  13.     str1  : string;
  14.    ftime  : longint;
  15.    tcrc   : word;
  16.    dt : datetime;
  17.    blocknum,
  18.    counter,
  19.    result : integer;
  20. BEGIN
  21.  
  22.      (* Build Ymodem header block - block 0 *)
  23.      FillChar(sector,SizeOf(sector),NULL); { chr(0) }
  24.      for j := 0 to length(filename)-1 DO sector[j] := Ord(filename[j+1]);
  25.      inc(j);
  26.      str(FileSize(f),str1);
  27.      for i := 1 to length(str1) DO sector[j+i] := Ord(str1[i]);
  28.      j := j + i + 1;
  29.      sector[j] := $20;
  30.      GetFTime(f,ftime);
  31.      UnPackTime(ftime,dt);
  32.      str1 := Octal(Since70(dt));
  33.      For i := 1 to length(str1) do sector[j+i] := Ord(str1[i]);
  34.      sector[j+i+1] := $20;
  35.  
  36.      (* Send header packet *)
  37.      REPEAT
  38.         Send(SOH);
  39.         Send(#0);
  40.         Send(#$FF);
  41.         SendBlk(seg(sector[0]),ofs(sector[0]),128);
  42.         crc := 0;
  43.         crca(Sector,SizeOf(sector),crc);
  44.         Send(CHR(Hi(crc)));
  45.         Send(CHR(Lo(crc)));
  46.         PurgeLine;
  47.      UNTIL (readline(10) = Ord(ACK));
  48.  
  49.      blocknum := 1;
  50.      str((filesize(f) DIV 1024):5,temp);
  51.      WriteLn('File open:' + temp + ' records.');
  52.      REPEAT
  53.         counter := 0;
  54.         FillChar(block,SizeOf(block),CPMEOF);
  55.         {$I-} blockread(f,block,SizeOf(block),result); {$I+}
  56.         if IOResult <> 0 then
  57.         begin
  58.            WriteLn('Error Reading File: CANCELLED');
  59.            FOS.Send(CAN);
  60.            FOS.Send(CAN);
  61.            Exit;
  62.         end;
  63.         REPEAT
  64.            Write(cr,'Sending block: ',blocknum);
  65.            Send(STX);
  66.            Send(CHR(blocknum));
  67.            Send(CHR(-blocknum-1));
  68.            SendBlk(seg(block[0]),ofs(block[0]),1024);
  69.            crc := 0;
  70.            Crca(block,sizeof(block),crc);
  71.            Send(CHR(Hi(crc)));
  72.            Send(CHR(Lo(crc)));
  73.            PurgeLine;
  74.            Inc(counter);
  75.         UNTIL (readline(10) = Ord(ACK)) OR (counter = retrymax);
  76.         inc(blocknum);
  77.      UNTIL EOF(f) OR (counter = retrymax) OR (NOT Carrier);
  78.  
  79.      IF counter = retrymax THEN
  80.          Writeln(CR,LF,'No ACK on sector')
  81.      ELSE
  82.      BEGIN
  83.          counter := 0;
  84.          REPEAT
  85.            Send(EOT);
  86.            Inc(counter);
  87.          UNTIL (readline(10) = Ord(ACK)) or (counter=retrymax);
  88.          IF counter = retrymax THEN
  89.             WriteLn(CR,LF,'No ACK on EOT')
  90.          ELSE WriteLn(CR,LF,'Transfer complete');
  91.      END;
  92.  
  93.      (*  Send a null header block to signify end of transfer! *)
  94.      counter := 0;
  95.      REPEAT
  96.         FillChar(sector,SizeOf(sector),CHR(0));  { NULL := CHR(0) }
  97.         Send(SOH);
  98.         Send(#$00);
  99.         Send(#$FF);
  100.         SendBlk(seg(sector[0]),ofs(sector[0]),128);
  101.         crc := 0;
  102.         crca(Sector, SizeOf(sector), crc);
  103.         Send(CHR(Hi(crc)));
  104.         Send(CHR(Lo(crc)));
  105.         inc(counter);
  106.      UNTIL (Readline(10) = Ord(ACK)) or (counter = retrymax);
  107. END;
  108.  
  109.  
  110. (*  
  111.     PROCEDURE PackDateAndTime(var pd : date; dt : DateTime);
  112.     { Returns the number of seconds since 00:00:00 01/01/1970 }
  113.     CONST TDays : array[boolean,0..12] of word =
  114.            ((0,31,59,90,120,151,181,212,243,273,304,334,365),
  115.            (0,31,60,91,121,152,182,213,244,274,305,335,366));
  116.           diff  = 347155200;
  117.     VAR total,
  118.         temp   : date;
  119.         lyr    : boolean;
  120.     BEGIN
  121.        lyr := (((dt.year mod 4 = 0) and (dt.year mod 100 <>0))
  122.               or (dt.year mod 400 = 0));
  123.        dec(dt.year,1981);
  124.        total := date(dt.sec) + (dt.min * 60) + (date(dt.hour) * 3600);
  125.        temp := date(dt.year) * word(365) + (dt.year div 4);
  126.        inc(temp,TDays[lyr][dt.month-1]);
  127.        inc(temp,dt.day-1);
  128.        pd := total + (temp * 86400) + diff;
  129.     END;  {PackDateAndTime}
  130.  
  131.     crc := 0;
  132.     crca(block, SizeOf(block), crc);
  133.     Send(CHR(Hi(crc)));
  134.     Send(CHR(Lo(crc)));
  135.     BlockCRC(Seg(block),Ofs(block),1023);
  136.     Send(CHR(Hi(crc_reg_hi)));
  137.     Send(CHR(Lo(crc_reg_hi)));
  138.  
  139.     BlockCRC(Seg(sector[0]),ofs(sector[0]),127);
  140.     Send(CHR(Hi(crc_reg_hi)));
  141.     Send(CHR(Lo(crc_reg_hi)));
  142.  
  143.            {FOR j := 0 TO 1023 do begin
  144.                Send(block[j]);
  145.                updcrc(tcrc,block[j]);
  146.            end;
  147.            }
  148. *)
  149.